perm filename TRUNC.OLD[SCR,LCS] blob
sn#369170 filedate 1978-07-26 generic text, type T, neo UTF8
SUBROUTINE TRUNC
DIMENSION PX(2592),PXL(2592),COPY(1),COPYL(1)
C 96*27=2592 STARTS WITH PARAM #4 → 99.
COMMON INUM,M,CNT(1) /P/P(1) /PL/PL(1) /COPY/NUMP,COPY,COPYL
1 /C/T,NWZZ,IT3,T6,NW,TDUR,A,T2,T4,BY,
1 KODE,NPAR,LP,TBG,AC,NPA
L=(INUM-1)*96-3
IF(CNT(INUM).GT.1)GO TO 3
C INIT THE LIST.
DO 4 K=4,NPA
4 PX(K+L)='$'
3 NPX=0
DO 1 K=NPA,4,-1
N=K+L
X=PL(K)
IF(P(K).NE.PX(N))GO TO 2
CC IF(X.GT.2)GO TO 2
IF(X.EQ.PXL(N))GO TO 1
2 IF(NPX.EQ.0)NPX=K
PX(N)=P(K)
PXL(N)=X
1 CONTINUE
NPA=3
IF(NPX.NE.0)NPA=NPX
END